{-# LANGUAGE ScopedTypeVariables, RankNTypes, NoMonomorphismRestriction, GADTs, StandaloneDeriving#-}

module EpuAlloc where

import Control.Monad.State
import Foreign (Ptr, Storable, sizeOf, alignment, peek, peekArray, poke, pokeArray, castPtr, allocaArray)
import Data.List (find, intersperse)
import Data.Maybe (fromJust)
import Text.Printf

import E_Data
import E_rawAPI
import E_API

data EpuBlock = EpuBlock { ebName :: String, ebArray :: [Int]}
    deriving (Show)

ebSize :: EpuBlock -> Int
ebSize na = (length $ ebArray na) * sizeOf (0::Int)

newtype EpuAddr = EpuAddr {fromEpuAddr :: Int}
    deriving (Eq, Ord, Show)

offset :: EpuAddr -> Int -> EpuAddr
offset (EpuAddr a) o = EpuAddr (a+o)

data EpuAlloc = EpuAlloc { eaName :: String, eaAddr :: EpuAddr, eanBytes :: Int, eaVal :: [Int] }
instance Show EpuAlloc where
    show e = printf "*%s = 0x%4x, %d bytes: %s" name addr bytes (shorten 6 initVal)
        where EpuAlloc name (EpuAddr addr) bytes initVal =  e
              shorten n arr
                | length arr <= n = show arr
                | otherwise       = "[" ++ msum (intersperse ", " (map show (take n arr))) ++ " ...]"

addrAfter :: EpuAlloc -> EpuAddr
addrAfter ea = offset (eaAddr ea) (eanBytes ea)

allocate :: EpuAddr -> [EpuBlock] -> [EpuAlloc]
allocate base eas = let start = EpuAlloc ".base" base 0 []
                        allocOne eaPrev b = EpuAlloc (ebName b) (addrAfter eaPrev) (ebSize b) (ebArray b)
                    in tail $ scanl allocOne start eas

findBlock :: [EpuAlloc] -> String -> EpuAlloc
findBlock eas wanted = let match ea = eaName ea == wanted
                       in fromJust $ find match eas

makeDecl :: EpuAlloc -> String
makeDecl ea = let EpuAlloc name addr _ _ = ea
    in printf "unsigned *%s = (unsigned *)0x%04x;" name (fromEpuAddr addr)
--    in printf "#define %s 0x%08x" name (fromEpuAddr addr)
--    in "#define " ++ name ++ " " ++ show (fromEpuAddr addr)

writeEpuBlock :: GroupRef -> EpuPos -> EpuAlloc -> IO ()
writeEpuBlock groupref (EpuPos row col) ea = do
    let EpuAlloc name (EpuAddr addr) nBytes initVal = ea 
    allocaArray (length initVal) (\ptr -> do
        pokeArray ptr initVal
--        putStrLn $ printf "writeEpuBlock %s (%d,%d) 0x%x 0x%x" name row col addr nBytes
        result <- e_group_write groupref row col addr (castPtr ptr) nBytes
        return ())

readEpuBlock :: GroupRef -> EpuPos -> EpuAlloc -> IO [Int]
readEpuBlock groupref (EpuPos row col) allocation = do
    let EpuAlloc name (EpuAddr addr) nBytes _ = allocation 
    let arrlen = quot nBytes (sizeOf (0::Int))
    allocaArray arrlen (\ptr -> do
        result <- e_group_read groupref row col addr (castPtr ptr) nBytes
        arr <- peekArray arrlen ptr
        return arr)

writeEpuData :: GroupRef -> EpuPos -> [EpuAlloc] -> IO()
writeEpuData groupref pos eas = do
    mapM_ (writeEpuBlock groupref pos) eas 



